home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 25 / AMIGAplus Sonderheft 25 (2000)(Falke)(DE)(Track 1 of 4)[!].iso / PublicDomain / Anwendungen / TimeOut / TimeOut.AMOS / TimeOut.amosSourceCode
AMOS Source Code  |  1996-04-12  |  3KB  |  109 lines
  1. Screen Open 0,640,512,16,Hires
  2. Hide : Curs Off : Flash Off : Paper 0 : Cls : T=1 : Y1=31
  3. Do 
  4.    Paper 0 : Locate X2,Y2 : Print "                                "
  5.    Inc Y1
  6.    Paper 0 : Locate 0,Y1-1 : Print "                                                                                "
  7.    Paper 6 : Locate 0,Y1 : Print "                                                                                "
  8.    If Y1=32
  9.       Y1=0
  10.       Paper 0 : Locate 0,32 : Print "                                                                                "
  11.       Paper 6 : Locate 0,0 : Print "                                                                                "
  12.    End If 
  13.    '
  14.    X2=Rnd(40) : Y2=Rnd(30)
  15.    Paper 4 : Pen 2 : T=0 : Locate X2,Y2
  16.    If ABOUT>0
  17.       If ABOUT=10
  18.          Print "  -- TIME OUT --  "
  19.       End If 
  20.       If ABOUT=9
  21.          Print " A SCREENSAVER "
  22.       End If 
  23.       If ABOUT=8
  24.          Print " BY LEE HESSELDEN "
  25.       End If 
  26.       If ABOUT=7
  27.          Print " OF SATANIC DREAMS "
  28.       End If 
  29.       If ABOUT=6
  30.          Print " MADE IN 1999 "
  31.       End If 
  32.       If ABOUT=5
  33.          Print " WRITTEN USING AMOS 1.3 "
  34.       End If 
  35.       If ABOUT=4
  36.          Print " eMAIL: gimmeloads@beer.com "
  37.       End If 
  38.       If ABOUT=3
  39.          Print " WWW: http://www.thisis.evil.nu "
  40.       End If 
  41.       If ABOUT=2
  42.          Print " THIS IS MAILWARE "
  43.       End If 
  44.       Dec ABOUT
  45.    End If 
  46.       If ABOUT=0
  47.          _DATE$ : Print " ";Param$;
  48.          _TIME$ : Print "  ";Param$;" "
  49.       End If 
  50.    For WAI=1 To 5000
  51.       If Mouse Key=1 Then End 
  52.       If Mouse Key=2 Then ABOUT=10
  53.    Next WAI
  54. Loop 
  55. '
  56. Procedure _DATE$
  57.    '
  58.    ' Call DOS DateStamp function
  59.    T$=Space$(12)
  60.    Dreg(1)=Varptr(T$)
  61.    RIEN=Doscall(-192)
  62.    NJ=Leek(Varptr(T$))
  63.    '
  64.    ' Find this year's first day 
  65.    A=1978 : JOUR=7
  66.    Do 
  67.       BIS=0 : If(A and 3)=0 : BIS=1 : End If 
  68.       Exit If NJ-365-BIS<0
  69.       Add JOUR,1+BIS : If JOUR>7 : Add JOUR,-7 : End If 
  70.       Add NJ,-365-BIS
  71.       Inc A
  72.    Loop 
  73.    '
  74.    ' Find month 
  75.    M=1
  76.    Do 
  77.       Read N
  78.       Exit If NJ-N<0
  79.       Add NJ,-N : Inc M
  80.    Loop 
  81.    Inc NJ
  82.    '
  83.    ' Create the string
  84.    J$=Mid$(Str$(NJ),2) : If Len(J$)<2 : J$="0"+J$ : End If 
  85.    M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
  86.    A$=Mid$(Str$(A),2)
  87.    DATE$=J$+"-"+M$+"-"+A$
  88.    '
  89.    ' Length of each month 
  90.    Data 31,28+BIS,31,30,31,30,31,31,30,31,30,31
  91.    '
  92. End Proc[DATE$]
  93. Procedure _TIME$
  94.    '
  95.    ' Call DOS function
  96.    T$=Space$(12)
  97.    Dreg(1)=Varptr(T$)
  98.    RIEN=Doscall(-192)
  99.    MN=Leek(Varptr(T$)+4)
  100.    SEC=Leek(Varptr(T$)+8)
  101.    '
  102.    ' Minutes calculation
  103.    H=MN/60 : H$=Mid$(Str$(H),2) : If Len(H$)<2 : H$="0"+H$ : End If 
  104.    M=MN mod 60 : M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
  105.    '
  106.    ' Final string 
  107.    TIME$=H$+":"+M$
  108.    '
  109. End Proc[TIME$]